home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d11 / graph11.arc / GRAPHER.BAK < prev    next >
Text File  |  1991-08-21  |  15KB  |  596 lines
  1. (*$N+*)
  2. program BGIGrapher;
  3.  
  4. uses
  5.   Crt, Dos, Graph;
  6.  
  7. Const
  8.  MaxData = 600;
  9.  
  10. Type
  11.  Data = array [1..MaxData] of Extended;
  12.  GraphContents =  Record
  13.                     X,Y:Data;
  14.                     XMin,XMax,YMin,YMax:Extended;
  15.                     AbsXMax,AbsYMax:Extended;
  16.                  end;
  17.  
  18.  
  19.  
  20. var
  21.   FileName,Labels: string;
  22.   Graphs:GraphContents;   (* Some important info. on data *)
  23.   NoOfData,i,Starting,Ending:integer;
  24.   GraphDriver : integer;  (* The Graphics device driver *)
  25.   GraphMode   : integer;  (* The Graphics mode value *)
  26.   MaxX, MaxY  : word;     (* The maximum resolution of the screen *)
  27.   ErrorCode   : integer;  (* Reports any graphics errors *)
  28.   MaxColor    : word;     (* The maximum color value available *)
  29.   OldExitProc : Pointer;  (* Saves exit procedure address *)
  30.  
  31.  
  32. (* Display help screen *)
  33. procedure HelpScreen;
  34.  
  35. begin
  36.   Writeln ('FreeWare Experimental Grapher ');
  37.   Writeln ('(C)opyright TakaPuna 1991 Version 1.1');
  38.   Writeln ('Portions of the codes are (C)opyrighted by Borland International ');
  39.   Writeln;
  40.   Writeln ('Command Line Options:');
  41.   Writeln ('    FileName [All Labels] [Starting Ending Labels] ');
  42.   Writeln;
  43.   Writeln ('    FileName : Data file from a text file ');
  44.   Writeln ('    Starting : Starting index to view (integer)  ');
  45.   Writeln ('    Ending   : Ending index to view   (integer)  ');
  46.   Writeln ('    Labels   : Axis labels                       ');
  47.   Writeln;
  48.   Writeln ('Example:');
  49.   Writeln ('- To display all points and label the axis as');
  50.   Writeln ('  "X vs Y" >: Grapher FileName All X vs Y ');
  51.   Writeln ('- To display points #10 to #20 and label the axis as');
  52.   Writeln ('  "X vs Y" >: Grapher FileName 10 20 X vs Y ');
  53.   Writeln ('- All parameter must appear in order !!!!');
  54.   Halt (1);
  55. end;
  56.  
  57.  
  58. (*$F+*)
  59. (* Trap run time errors *)
  60. procedure UserExitProc;
  61. begin
  62.   ExitProc := OldExitProc; (* Restore exit procedure address *)
  63.   CloseGraph;
  64. end; (* UserExitProc *)
  65. (*$F-*)
  66.  
  67.  
  68. procedure Initialize;
  69. (* Initialize graphics and report any errors that may occur *)
  70. var
  71.   InGraphicsMode : boolean; (* Flags initialization of graphics mode *)
  72.   PathToDriver   : string;  (* Stores the DOS path to *.BGI & *.CHR *)
  73. begin
  74.   (* when using Crt and graphics, turn off Crt's memory-mapped writes *)
  75.   DirectVideo := False;
  76.   OldExitProc := ExitProc;                (* save previous exit proc *)
  77.   ExitProc := @UserExitProc;                (* insert our exit proc in chain *)
  78.   PathToDriver := '';
  79.   repeat
  80.  
  81. (*$IFDEF Use8514*)                          (* check for Use8514 $DEFINE *)
  82.     GraphDriver := IBM8514;
  83.     GraphMode := IBM8514Hi;
  84. (*$ELSE*)
  85.     GraphDriver := Detect;                (* use autodetection *)
  86. (*$ENDIF*)
  87.  
  88.     InitGraph(GraphDriver, GraphMode, PathToDriver);
  89.     ErrorCode := GraphResult;             (* preserve error return *)
  90.     if ErrorCode <> grOK then             (* error? *)
  91.     begin
  92.       Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  93.       if ErrorCode = grFileNotFound then  (* Can't find driver file *)
  94.       begin
  95.         Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
  96.         Readln(PathToDriver);
  97.       end
  98.       else
  99.         Halt(1);                          (* Some other error: terminate *)
  100.     end;
  101.   until ErrorCode = grOK;
  102.   MaxColor := GetMaxColor;  (* Get the maximum allowable drawing color *)
  103.   MaxX := GetMaxX;          (* Get screen resolution values *)
  104.   MaxY := GetMaxY;
  105. end; (* Initialize *)
  106.  
  107.  
  108. (* Returns true if file exists *)
  109. function FileExist (FileName:string):boolean;
  110.  
  111.  Var
  112.   F:Text;
  113.  
  114.  begin
  115.    (*$I-*)
  116.    Assign (F,FileName);
  117.    Reset (F);
  118.    FileExist:= IOResult = 0;
  119.   (*$I+*)
  120.  end;
  121.  
  122.  
  123.  
  124. function Int2Str(L : LongInt) : string;
  125. (* Converts integer to string *)
  126. var
  127.   S : string;
  128. begin
  129.   Str(L, S);
  130.   Int2Str := S;
  131. end; (* Int2Str *)
  132.  
  133.  
  134. function Str2Int(S:string):integer;
  135. (* Converts string to integer *)
  136. var
  137.  L,Code:integer;
  138.  
  139.  begin
  140.   Val(S,L,Code);
  141.   if Code <> 0 then
  142.    begin
  143.     Writeln ('Integer values expected as parameters.');
  144.     Halt(1);
  145.    end
  146.   else
  147.   Str2Int:=L;
  148.  end;
  149.  
  150.  
  151. function Real2Str(L : Extended) : string;
  152. (* Converts Extended numbers to string *)
  153. var
  154.   S : string;
  155. begin
  156.   Str(L:0, S);
  157.   Real2Str := S;
  158. end; (* Real2Str *)
  159.  
  160. (* Check if the Parameter is equal to the Switch *)
  161. function IsEqual(Parameter,Switch:String):boolean;
  162.  
  163.  var
  164.   Quit:boolean;
  165.  
  166.  begin
  167.   Quit:=false;
  168.   i:=0;
  169.   While not Quit do
  170.    begin
  171.     Inc(i);
  172.     Quit:=(Upcase(Switch[i])<>Upcase(Parameter[i])) or (i=Length(Switch));
  173.    end;
  174.    if i=Length(Switch) then
  175.     IsEqual:=true
  176.    else
  177.     IsEqual:=false;
  178.  end;
  179.  
  180. procedure DefaultColors;
  181. (* Select the maximum color in the Palette for the drawing color *)
  182. begin
  183.   SetColor(MaxColor);
  184. end; (* DefaultColors *)
  185.  
  186.  
  187. procedure FullPort;
  188. (* Set the view port to the entire screen *)
  189. begin
  190.   SetViewPort(0, 0, MaxX, MaxY, ClipOff);
  191. end; (* FullPort *)
  192.  
  193. procedure MainWindow(Header : string);
  194. (* Make a default window and view port for demos *)
  195. begin
  196.   DefaultColors;                           (* Reset the colors *)
  197.   SetTextStyle(SmallFont, HorizDir, 5);
  198.   SetTextJustify(CenterText, TopText);     (* Left justify text *)
  199.   FullPort;                                (* Full screen view port *)
  200.   OutTextXY(MaxX div 2,0, Header);        (* Draw the header *)
  201.   (* Draw main window *)
  202.   SetViewPort (Round(0.2*MaxX),Round(0.1*MaxY),Round(0.9*MaxX),Round(0.7*MaxY),
  203.                ClipOff);
  204.  
  205. end; (* MainWindow *)
  206.  
  207.  
  208. procedure WaitToGo;
  209. (* Wait for the user to abort the program or continue *)
  210. const
  211.   Esc = #27;
  212. var
  213.   Ch : char;
  214. begin
  215.   repeat until KeyPressed;
  216.   Ch := ReadKey;
  217.   if ch = #0 then ch := readkey;      (* trap function keys *)
  218.   if Ch = Esc then
  219.     Halt(0)                           (* terminate program *)
  220.   else
  221.     ClearDevice;                      (* clear screen *)
  222.  
  223. end; (* WaitToGo *)
  224.  
  225.  
  226.  
  227. (* Initialize the Graph Record *)
  228. procedure InitGlobal (UserGivenFile:string);
  229.  
  230. var
  231.  FileName:text;
  232.  j:integer;
  233.  a,b:Extended;
  234.  TXmax,TXmin,TYmax,TYmin:Extended;
  235.  Quit:boolean;
  236.  
  237.  begin
  238.    NoOfData:=0;
  239.    j:=1;
  240.    i:=1;
  241.    ClrScr;
  242.    Quit:=false;
  243.    Assign (FileName,UserGivenFile);
  244.    Reset (FileName);
  245.    While not Quit do
  246.     begin
  247.      (*$I-*)
  248.      Readln (FileName,a,b);
  249.      (*$I+*)
  250.      if IOResult = 0 then
  251.        begin
  252.          if ParamCount > 2 then
  253.           begin
  254.            if (j>=Starting) and (j<=Ending) then
  255.             begin
  256.              Graphs.X[i]:=a;
  257.              Graphs.Y[i]:=b;
  258.              Inc (NoOfData);
  259.              Inc (i);
  260.             end;
  261.           end
  262.          else
  263.            begin
  264.             Graphs.X[i]:=a;
  265.             Graphs.Y[i]:=b;
  266.             Inc (NoOfData);
  267.             Inc(i);
  268.            end;
  269.          Inc(j);
  270.        end
  271.      else
  272.       Writeln ('Some Invalid entries skipped ');
  273.     Quit:=(NoOfData = MaxData) or EOF(FileName);
  274.   end;  (* While not Quit *)
  275.  Close (FileName);
  276.  
  277.  if (NoOfData = MaxData) then
  278.    begin
  279.     Writeln ('Too many data .....Aborting program.  Maximum data = ',MaxData);
  280.     Halt(1);
  281.    end
  282.   else
  283.  
  284.    begin
  285.     TXmax:=Graphs.X[1];  (* find the maximum and the minimum of data *)
  286.     TXMin:=Graphs.X[1];
  287.     TYMax:=Graphs.Y[1];
  288.     TYMin:=Graphs.Y[1];
  289.  
  290.     for i:=1 to NoOfData do
  291.      begin
  292.       if Graphs.X[i] > TXMax then
  293.         TXMax:=Graphs.X[i];
  294.  
  295.       if Graphs.X[i] < TXMin then
  296.         TXMin:=Graphs.X[i];
  297.  
  298.       if Graphs.Y[i] > TYMax then
  299.         TYMax:=Graphs.Y[i];
  300.  
  301.       if Graphs.Y[i] < TYMin then
  302.         TYMin:=Graphs.Y[i];
  303.      end;
  304.  
  305.      Graphs.XMax:=TXMax;
  306.      Graphs.XMin:=TXMin;
  307.      Graphs.YMax:=TYMax;
  308.      Graphs.YMin:=TYMin;
  309.  
  310.      if (Abs(TXmin) > Abs(TXMax)) then
  311.       Graphs.AbsXMax:=Abs(TXMin)
  312.      else
  313.       Graphs.AbsXMax:=Abs(TXMax);
  314.  
  315.      if (Abs(TYmin) > Abs(TYMax)) then
  316.       Graphs.AbsYMax:=Abs(TYMin)
  317.      else
  318.       Graphs.AbsYMax:=Abs(TYMax);
  319.  
  320.  
  321.   end;
  322.  
  323. end;  (*  InitGlobal *)
  324.  
  325.  
  326. procedure Status(Msg : string);
  327. (* report the status of graph *)
  328.  
  329. begin
  330.   FullPort;
  331.   DefaultColors;
  332.   SetTextJustify(CenterText, TopText);
  333.   SetLineStyle(SolidLn, 0, NormWidth);
  334.   SetFillStyle(EmptyFill, 0);
  335.   OutTextXY(MaxX div 2,MaxY-(TextHeight('M')+20),Msg);
  336.   (* Draw main window back again *)
  337.   SetViewPort (Round(0.2*MaxX),Round(0.1*MaxY),Round(0.9*MaxX),Round(0.7*MaxY),
  338.                ClipOff);
  339.  
  340. end; (* Status *)
  341.  
  342.  
  343. procedure DrawBorder;
  344. (* Draw a border around the current view port
  345.    and labels the axis                      *)
  346. var
  347.   ViewPort : ViewPortType;
  348.   IncX,IncY,Start:Extended;
  349.   Mult:Extended;
  350.  
  351. begin
  352.  
  353.   if (Graphs.XMax > 0) and (Graphs.XMin >= 0) then
  354.     IncX:=(Graphs.XMax-Graphs.XMin)/4;
  355.   if (Graphs.XMax < 0) and (Graphs.XMin < 0) then
  356.     IncX:=(-Abs(Graphs.XMax)+Abs(Graphs.XMin))/4;
  357.   if (Graphs.XMax >= 0) and (Graphs.XMin < 0) then
  358.      IncX:=(Abs(Graphs.XMax)+Abs(Graphs.XMin))/4;
  359.  
  360.   if (Graphs.YMax=Graphs.YMin) then
  361.        IncY:=Abs(Graphs.YMax/4)
  362.   else
  363.    begin
  364.     If (Graphs.YMax > 0) and (Graphs.YMin >= 0) then
  365.      IncY:=(Graphs.YMax-Graphs.YMin)/4;
  366.     If (Graphs.YMax < 0) and (Graphs.YMin < 0) then
  367.      IncY:=(-Abs(Graphs.YMax)+Abs(Graphs.YMin))/4;
  368.     if (Graphs.YMax >= 0) and (Graphs.YMin < 0) then
  369.      IncY:=(Abs(Graphs.YMax)+Abs(Graphs.YMin))/4;
  370.    end;
  371.  
  372.   Status ('Step size X = '+Real2Str(IncX)+
  373.           '   Step size Y ='+Real2Str(IncY));
  374.  
  375.   DefaultColors;
  376.   SetLineStyle(SolidLn,0, ThickWidth);
  377.   GetViewSettings(ViewPort);
  378.   SetTextStyle(SmallFont, HorizDir, 5);
  379.   with ViewPort do
  380.    begin
  381.     Rectangle(0, 0, x2-x1, y2-y1);
  382.  
  383.     (* Rectangle edges *)
  384.     Line (X2-X1+4,0,X2-X1-1,0);
  385.     Line (0,-4,0,1);
  386.     Line (0,Y2-Y1+4,0,Y2-Y1-1);
  387.     Line (-4,0,1,0);
  388.  
  389.  
  390.     (* Draw ticks on Y axis *)
  391.     Mult:=0.25;
  392.     for i:=1 to 4 do
  393.      begin
  394.        Line (X2-X1+4,Round(Mult*(Y2-Y1)),X2-X1-1,Round(Mult*(Y2-Y1)));
  395.        Line (-4,Round(Mult*(Y2-Y1)),1,Round(Mult*(Y2-Y1)));
  396.        Mult:=Mult+0.25;
  397.      end;
  398.  
  399.     (* Label the Y Axis *)
  400.     if (Graphs.YMax=Graphs.YMin) then
  401.       Start:=Graphs.YMax-(2*IncY)
  402.     else
  403.       Start:=Graphs.YMin;
  404.  
  405.     Mult:=1;
  406.     for i:=1 to 5 do
  407.      begin
  408.        OutTextXY (-4-TextWidth(Real2Str(Start)),Round(Mult*(Y2-Y1))-TextHeight(Real2Str(Start)),
  409.                   Real2Str(Start));
  410.        Mult:=Mult-0.25;
  411.        Start:=Start+IncY;
  412.      end;
  413.  
  414.  
  415.     (* Draw ticks on X axis *)
  416.     Mult:=0.25;
  417.     for i:=1 to 4 do
  418.      begin
  419.       Line (Round(Mult*(X2-X1)),-4,Round(Mult*(X2-X1)),1);
  420.       Line (Round(Mult*(X2-X1)),Y2-Y1+4,Round(Mult*(X2-X1)),Y2-Y1-1);
  421.       Mult:=Mult+0.25;
  422.      end;
  423.  
  424.  
  425.     (* Label the X axis *)
  426.     Mult:=0;
  427.     Start:=Graphs.Xmin;
  428.     for i:=1 to 5 do
  429.      begin
  430.       OutTextXY (Round(Mult*(X2-X1))-TextWidth(Real2Str(Start)) div 4,Y2-Y1+TextHeight(Real2Str(Start)),
  431.                  Real2Str(Start));
  432.       Mult:=Mult+0.25;
  433.       Start:=Start+IncX;
  434.      end;
  435.  
  436.   end;  (* with ViewPort *)
  437.  
  438. end; (* DrawBorder *)
  439.  
  440.  
  441.  
  442. procedure ScaleData;
  443. (* Scale the data such that it will fall inside the viewport *)
  444.  
  445.  var
  446.   ShiftX,ShiftY:integer;
  447.   Xscale,YScale:Extended;
  448.   ViewPort:ViewPortType;
  449.  
  450.  begin
  451.   GetViewSettings(ViewPort);
  452.   With ViewPort do
  453.    begin
  454.     (* Put some conditions on X *)
  455.     if (Graphs.XMax=Graphs.XMin) then
  456.       begin
  457.        Writeln ('Data does not make sense ');
  458.        Halt(1);
  459.       end;
  460.  
  461.     if (Graphs.XMax > 0 ) and (Graphs.XMin > 0) then (* XMax > 0 *)
  462.      begin                                           (* XMin > 0 *)
  463.       XScale:=(X2-X1)/(Graphs.XMax-Graphs.XMin);
  464.       ShiftX:=-Round(Graphs.XMax*XScale-X2+X1);
  465.      end
  466.     else
  467.      begin
  468.         if Graphs.XMax > 0 then       (* absolutely no zero *)
  469.          begin
  470.           ShiftX:=Round((1-(Graphs.XMax/(Graphs.XMax + Abs(Graphs.Xmin))))*(X2-X1));
  471.           XScale:=(X2-(ShiftX+X1))/(Graphs.XMax);
  472.           if XScale = 0 then
  473.            XScale:=(X2-X1)/(Graphs.AbsXMax)
  474.          end
  475.         else
  476.          begin
  477.           XScale:=(X2-X1)/(Graphs.XMax-Graphs.XMin);
  478.           ShiftX:=-Round(Graphs.XMax*XScale-X2+X1);
  479.          end;
  480.     end;
  481.  
  482.    (* Put Some condition on Y *)
  483.    if (Graphs.YMax=Graphs.YMin) then
  484.     begin
  485.      for i:=1 to NoOfData do
  486.       begin
  487.        Graphs.X[i]:=Graphs.X[i]*XScale+ShiftX;
  488.        Graphs.Y[i]:=0.5*(Y2-Y1);
  489.       end;
  490.     end
  491.    else
  492.     begin
  493.      if (Graphs.YMax > 0 ) and (Graphs.YMin > 0) then (* YMax > 0 *)
  494.        begin                                           (* YMin > 0 *)
  495.         YScale:=(Y2-Y1)/(Graphs.YMax-Graphs.YMin);
  496.         ShiftY:=-Round(Graphs.YMax*YScale-y2+y1);
  497.        end
  498.      else
  499.       begin
  500.        if (Graphs.YMax > 0) then
  501.         begin
  502.          ShiftY:=Round((1-(Graphs.YMax/(Graphs.YMax + Abs(Graphs.Ymin))))*(Y2-Y1));
  503.          YScale:=(Y2-(ShiftY+Y1))/Graphs.YMax;
  504.          if YScale= 0 then
  505.           YScale:=(Y2-Y1)/(Graphs.AbsYMax);
  506.         end
  507.        else
  508.         begin
  509.          YScale:=(Y2-Y1)/(Graphs.YMax-Graphs.YMin);
  510.          ShiftY:=-Round(Graphs.YMax*YScale-y2+y1);
  511.         end;
  512.     end;
  513.      for i:=1 to NoOfData do
  514.       begin
  515.        Graphs.X[i]:=Graphs.X[i]*XScale+ShiftX;
  516.        Graphs.Y[i]:=Graphs.Y[i]*YScale+ShiftY;
  517.       end;
  518.      end;
  519.    end;
  520.  
  521. end;  (* Scale Data *)
  522.  
  523.  
  524. procedure Plot;
  525. (* plot the given data in the array *)
  526.  
  527. var
  528.  ViewPort:ViewPortType;
  529.  
  530. begin
  531.  SetLineStyle(SolidLn, 0, NormWidth);
  532.  GetViewSettings(ViewPort);
  533.  With ViewPort do
  534.   begin
  535.    MoveTo (Round(Graphs.X[1]),
  536.           (Y2-Y1)-Round(Graphs.Y[1]));
  537.    for i:=2 to NoOfData do
  538.     LineTo (Round(Graphs.X[i]),
  539.             (Y2-Y1)-Round(Graphs.Y[i]));
  540.   end;
  541. end; (* Plot *)
  542.  
  543.  
  544. (* Handles command line input *)
  545. procedure CommandLine;
  546.  
  547.  begin
  548.   if ParamCount = 0 then
  549.    HelpScreen
  550.   else
  551.    begin
  552.     Labels:='';
  553.     FileName:=ParamStr(1);
  554.     if NOT FileExist(FileName) then
  555.        begin
  556.         Writeln ('File ',FileName,' does not exist.');
  557.         Halt(1);
  558.        end;
  559.     if ParamCount > 2 then
  560.      begin
  561.       if Not (IsEqual(ParamStr(2),'All')) then
  562.        begin
  563.         Starting:=Str2Int(ParamStr(2));
  564.         Ending:=Str2Int(ParamStr(3));
  565.         if (Starting > Ending) then
  566.          begin
  567.           Writeln ('Starting index must be less than ending index. ');
  568.           Halt(1);
  569.          end;
  570.         for i:=4 to ParamCount do
  571.          Labels:=Labels +' '+ ParamStr(i);
  572.       end
  573.      else
  574.       begin
  575.         Starting:=1;
  576.         Ending:=MaxData;
  577.         for i:=3 to ParamCount do
  578.          Labels:=Labels +' '+ ParamStr(i);
  579.       end;
  580.     end;
  581.    end;
  582.  end;
  583.  
  584.  
  585. begin (* program body *)
  586.   ClrScr;
  587.   CommandLine;
  588.   InitGlobal (FileName);
  589.   Initialize;
  590.   MainWindow (Labels);
  591.   ScaleData;
  592.   DrawBorder;
  593.   Plot;
  594.   WaitToGo;
  595. end.
  596.